home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tvtoys04.zip / VIDEOTST.PAS < prev   
Pascal/Delphi Source File  |  1993-12-18  |  10KB  |  289 lines
  1. (***************************************************************************
  2.   VideoTest program
  3.   Demonstrates the Video, ModeDlg and TVVideo units
  4.   PJB October 8, 1993, Internet mail to d91-pbr@nada.kth.se
  5.   Copyright 1993, All Rights Reserved
  6.   Free source, use at your own risk.
  7.   If modified, please state so if you pass this around.
  8.  
  9.   ■ This program's functionality can be altered by editing TOYCFG.PAS
  10.  
  11.   What this demonstration program does:
  12.     The menu bar lets you choose between File, Video and Info.
  13.     The Video menu lets you toggle between 25 and 43/50 lines, select
  14.     a video mode and choose between internal video card fonts.
  15.  
  16.     If you choose Select video mode, you will see some warnings.
  17.     Read them, press the "Run test" button and wait while the program
  18.     scans for available video modes. Don't be alerted if your screen
  19.     flashes. If you do not see a dialog box within four seconds, the
  20.     computer probably crashed. This is a problem with very old (usually
  21.     EGA) video BIOSes.
  22.  
  23.     If you have VESA text support you will instantly see the available
  24.     video modes without any flashing. UNIVESA by Kendall Bennett does
  25.     not provide text mode support, so there will be flashing if there is
  26.     no additional VESA support.
  27.  
  28.     The dialog shows a list of text modes found. Press Enter to preview
  29.     a video mode for two thirds of a second (if your monitor goes
  30.     bonkers, just wait for one second and the screen will be restored.
  31.     This means your monitor cannot cope with that video mode's
  32.     resolution (e.g. displaying 60 lines with a VGA card on a standard
  33.     EGA monitor))
  34.  
  35.     The following has been known to happen with fixed-sync VGAs:
  36.     (this was an older PS/2 monitor, one user with a fixed-sync VGA
  37.     reports that all is fine, my fixed sync EGA monitor copes, and
  38.     multi-sync monitors have no problems)
  39.     If your monitor emits "cracks" while in this video mode, your screen
  40.     fuse (easily replaced) might melt if the monitor is subjected to
  41.     that video mode for a longer period of time. You can always turn the
  42.     monitor off if you think it is breaking down.
  43.  
  44.     ■ Your mouse driver probably won't manage with extended video modes
  45.     (especially not if it is a Microsoft driver). Check out the NewMouse
  46.     unit supplied, define UseNewMouse in TOYCFG to use it.
  47.  
  48.     This program has been tested on a variety of machines with different
  49.     hardware and video cards without any problems, but the very nature
  50.     of this program makes it likely that there will be compatibility
  51.     problems.
  52.  
  53. ***************************************************************************)
  54. program VideoTst;
  55.  
  56. {$I toyCfg}
  57.  
  58. {$B-,X+}
  59.  
  60.   uses
  61.     Dos,
  62.     App, Dialogs, Drivers, Memory, Menus, MsgBox, Objects, Views,
  63.    {$IFDEF Color}
  64.     ColorTxt,
  65.    {$ENDIF}
  66.     toyPrefs,                   (* Your preferences! *)
  67.     HelpCtx,                    (* Some help contexts from TVHC *)
  68.     FontDlg,                    (* Font selection dialog *)
  69.     ModeDlg,                    (* Video mode selection dialog *)
  70.     Video,                      (* Video type *)
  71.     toyApp,                     (* App inherits TToyApp *)
  72.     TVVideo;                    (* Toggle video lines *)
  73.  
  74.   type
  75.     TVideoApp =
  76.       object (TToyApp)
  77.         constructor Init;
  78.         procedure InitMenubar; virtual;
  79.         procedure HandleEvent(var Event:TEvent); virtual;
  80.         function  MakeVideoInfoDialog : PDialog;
  81.       end;
  82.  
  83.  
  84.   (*******************************************************************
  85.     Demo commands
  86.   *******************************************************************)
  87.   const
  88.     toyStart     = 100;
  89.     cm8p         = toyStart+0;
  90.     cm14p        = toyStart+1;
  91.     cm16p        = toyStart+2;
  92.     cmVideoMode  = toyStart+3;
  93.     cmVideoLines = toyStart+4;
  94.     cmVideoInfo  = toyStart+5;
  95.     cmSelectFont = toyStart+6;
  96.  
  97.  
  98.   (*******************************************************************
  99.     Include warnings dialog
  100.   *******************************************************************)
  101.   {$I IMPRTANT.PAS}
  102.  
  103.  
  104.   (*******************************************************************
  105.     Init, check video type
  106.   *******************************************************************)
  107.   constructor TVideoApp.Init;
  108.   begin
  109.     (* Detect video type, save DOS video mode, start TV *)
  110.     inherited Init;
  111.  
  112.     (* Disable some features on non VGA cards *)
  113.     if VideoType=Other then
  114.       DisableCommands([cmVideoMode, cmVideoLines, cmSelectFont, cm14p, cm16p])
  115.     else
  116.       VideoModeChanged:=ReloadLastFont;
  117.  
  118.     if VideoType=EGA then
  119.       DisableCommands([cm16p]);
  120.  
  121.     if VideoType=Other then
  122.       MessageBox('This program intended for EGA/VGA', nil, mfInformation+mfOKButton);
  123.  
  124.     HelpFileName:='HELPTEST.HLP';
  125.     ShowHelp(hcVideoIntro);
  126.   end;
  127.  
  128.  
  129.   (*******************************************************************
  130.     Video mode commands
  131.     The HandleEvent inherited from toyApp deals with cmDosShell
  132.   *******************************************************************)
  133.   procedure TVideoApp.HandleEvent;
  134.     const
  135.       InternalArr : array [cm8p..cm16p] of Byte =
  136.         (Internal8x8Font, Internal8x14Font, Internal8x16Font);
  137.   begin
  138.     inherited HandleEvent(Event);
  139.  
  140.     if Event.What=evCommand then
  141.     begin
  142.       case Event.Command of
  143.         cm8p..cm16p:   TVVideo.SetInternalFont(InternalArr[Event.Command]);
  144.  
  145.         cmSelectFont:  SelectFontDialog('', Nil);      { ExeDir, maybe? }
  146.  
  147.         cmVideoMode:
  148.           if not HasToScan or  { Don't warn if modes already known }
  149.              (Application^.ExecuteDialog(MakeImportantDialog, Nil)=cmOK) then
  150.           begin
  151.             SetUpVideoList;
  152.             SelectVideoModeDialog;
  153.           end;
  154.         cmVideoLines:  ToggleVideoLines;
  155.         cmVideoInfo:   ExecuteDialog(MakeVideoInfoDialog, Nil);
  156.         else
  157.           Exit;
  158.       end;
  159.       ClearEvent(Event);
  160.     end;
  161.   end;
  162.  
  163.  
  164.   (*******************************************************************
  165.     Menu bar
  166.   *******************************************************************)
  167.   procedure TVideoApp.InitMenubar;
  168.     var
  169.       R : TRect;
  170.   begin
  171.     GetExtent(R);
  172.     R.B.Y:=R.A.Y+1;
  173.     MenuBar:=New(PMenuBar, Init(R, NewMenu(
  174.       NewSubMenu('~F~ile', hcNoContext, NewMenu(
  175.         NewItem('~D~OS shell', '', kbNoKey, cmDosShell, hcDosShell,
  176.         NewItem('E~x~it', 'Alt+X', kbAltX, cmQuit, hcExit,
  177.         nil))),
  178.       NewSubMenu('~V~ideo', hcVideo, NewMenu(
  179.         NewItem('Toggle video ~l~ines', '', kbNoKey, cmVideoLines, hctoyVVideoLines,
  180.         NewItem('Select video ~m~ode...', '', kbNoKey, cmVideoMode, hctoyVVideoMode,
  181.         NewLine(
  182.         NewItem('Select ~f~ont...', '', kbNoKey, cmSelectFont, hctoyVSelectFont,
  183.         NewItem('Internal ~8~p font', '', kbNoKey, cm8p, hctoyV8p,
  184.         NewItem('Internal 1~4~p font', '', kbNoKey, cm14p, hctoyV14p,
  185.         NewItem('Internal 1~6~p font', '', kbNoKey, cm16p, hctoyV16p,
  186.         nil)))))))),
  187.       NewItem('~I~nfo', '', kbNoKey, cmVideoInfo, hcNoContext,
  188.     nil))))));
  189.   end;
  190.  
  191.  
  192.   (*******************************************************************
  193.     Create the video information dialog
  194.   *******************************************************************)
  195.   function TVideoApp.MakeVideoInfoDialog : PDialog;
  196.     var
  197.       R       : TRect;
  198.       Dlg     : PDialog;
  199.       Control : PView;
  200.       TempStr : string;
  201.       DataArr : array [0..3] of LongInt;
  202.  
  203.     procedure AddInfo(const S:String; Color:Byte);
  204.    {$IFDEF Color}
  205.       var
  206.         Text    : PColoredText;
  207.     begin
  208.       New(Text, Init(R, S, Color));
  209.       Dlg^.Insert(Text);
  210.       AddShadowTo(Text);
  211.     end;
  212.    {$ELSE}
  213.       var
  214.         Text    : PStaticText;
  215.     begin
  216.       New(Text, Init(R, S));
  217.       Dlg^.Insert(Text);
  218.     end;
  219.    {$ENDIF}
  220.  
  221.   begin
  222.     R.Assign(0, 0, 65, 14);
  223.     New(Dlg, Init(R, 'Video Info'));
  224.     Dlg^.Options := Dlg^.Options or ofCentered;
  225.  
  226.     R.Assign(4, 2, 61, 3);
  227.  
  228.     case VideoType of
  229.       VGA:   AddInfo(^C'VGA detected', $1F);
  230.       EGA:   AddInfo(^C'EGA detected', $1F);
  231.       Other: AddInfo(^C'EGA/VGA not detected', $1F);
  232.     end;
  233.  
  234.  
  235.     R.Move(0, 2);
  236.     DataArr[0]:=GetSpecialVideoMode;
  237.     DataArr[1]:=Mem[Seg0040:CrtWidth];
  238.     DataArr[2]:=Mem[Seg0040:CrtRows]+1;
  239.     DataArr[3]:=Mem[Seg0040:CrtPoints];
  240.     FormatStr(TempStr, '  Mode: %xh   Width: %d   Height: %d   CharHeight: %d', DataArr);
  241.     AddInfo(TempStr, $1F);
  242.  
  243.  
  244.     R.Move(0, 2);
  245.    {$IFDEF VesaSupport}
  246.     DataArr[0]:=Hi(VESA.VesaVersion);
  247.     DataArr[1]:=Lo(VESA.VesaVersion);
  248.     FormatStr(TempStr, '  VESA version %d.%d detected', DataArr);
  249.  
  250.     if VESA.VesaVersion=0 then
  251.       AddInfo('  VESA support not detected', $3F)
  252.     else
  253.       AddInfo(TempStr, $3F);
  254.    {$ELSE}
  255.     AddInfo('  VESA code not compiled', $4F);
  256.    {$ENDIF}
  257.  
  258.  
  259.     R.Move(0, 2);
  260.    {$IFDEF Video7Support}
  261.     if Video7 then
  262.       AddInfo('  Video 7 detected', $3F)
  263.     else
  264.       AddInfo('  Video 7 not detected', $3F);
  265.    {$ELSE}
  266.       AddInfo('  Video 7 code not compiled', $4F);
  267.    {$ENDIF}
  268.  
  269.  
  270.     R.Assign(27, 11, 37, 13);
  271.     Control := New(PButton, Init(R, 'O~K~', cmOK, bfDefault));
  272.     Dlg^.Insert(Control);
  273.  
  274.     Dlg^.SelectNext(False);
  275.     MakeVideoInfoDialog := Dlg;
  276.   end;
  277.  
  278.     (*******************************************************************
  279.     *******************************************************************)
  280.  
  281.   var
  282.     VideoApp : TVideoApp;
  283.  
  284. begin
  285.   VideoApp.Init;
  286.   VideoApp.Run;
  287.   VideoApp.Done;
  288. end.
  289.